home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1995 October
/
EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso
/
Aminet
/
comm
/
mebbs
/
cb_horses.lha
/
CBHORSES
/
horses.rexx
< prev
Wrap
OS/2 REXX Batch file
|
1994-11-16
|
33KB
|
977 lines
/***********************************************************************/
/* CHALKBOARD HORSES Horse Racing Door */
/* VARIABLE DECLARATIONS */
/***********************************************************************/
/* BBSname = name of the BBS this pfile is being run on */
/* Sysopname = name of the sysop offering this pfile */
/* Progname = name of this program */
/* FilePath = path to subdirectory for support files */
/* input = used in CHECKPANIC procedure to hold input argument */
/* Uhandle = Handle of current player */
/* Udate = Current date & time */
/* Uaccess = User's access number (0,23) */
/* CLS = User's screen clear code */
/* AcctBal = Current player's account balance */
/* LowBal = Flag to signal when player's acct balance is too low */
/* MaxPlayers= Maximum players allowed */
/* player.i = 'array' to hold all player handles */
/* score.i = 'array' to hold all player acct balances */
/* i, j = simple counters used in various places in program */
/* temp = temporary variable used when sorting/swapping */
/* nplayers = total number of players in Dplayers files */
/* Flag = used to signal different events */
/* More = used to ask if user wants to see more of the score list */
/* Choice = main menu choice */
/* Another = does player want to bet on ANOTHER race? */
/* Hname.i = horse names */
/* WHorse.i = horse(s) picked to win, show or place */
/* WBet.i = amount bet to win, show or place */
/* WOdds.i = holds the current "To win" odds on the horses */
/* POdds.i = holds the current "To place" odds on the horses */
/* SOdds.i = holds the current "To show" odds on the horses */
/* RNum = holds random numbers picked for horse race */
/* Count.i = holds the cumulative counter for each horse during race */
/* Win = holds number of WIN horse */
/* Place = holds number of PLACE horse */
/* Show = holds number of Show horse */
/* Guessadd = amount to be added to account ballance in guess game. */
/* REPS = holds number of repetitions of the Delay Loop (default) */
/***********************************************************************/
/* VARIABLE INITIALIZATIONS */
/***********************************************************************/
SIGNAL ON SYNTAX
SIGNAL ON IOERR
signal on ERROR
parse arg LineNumber
options results
DoorName = "HORSES"
if( ~show( 'l', "mebbsarexx.library" ) )then do
if( ~addlib( "mebbsarexx.library", 0, -30, 0 ) )then do
say "Could not open library"
exit 10
end
end
ver = " Chalkboard Downs v.160 by /\/\r. Ed"
Author = "Ed Kolar (M3004)"
string = "HH Opened Door by "author;call outputthendelay 1
/*Program variable initialization */
/* VariableNumbers: */
MaxPlayers = 20 /* max number of players allowed by sysop */
Dir = "Doors:Horses/"
reps = 1
/**********************************************************************/
/* MY STANDARD TEMPLATE STARTS HERE */
/**********************************************************************/
call getvar Doorname,LineNumber,1
username=result
call getvar DoorName,LineNumber,21
handlename=result
call getvar DoorName,LineNumber,11
ncalls=result
call getvar DoorNmae,LineNumber,14
bbs_path=result
call getvar DoorName,LineNumber,4
city=result
call getvar DoorName,LineNumber,5
state=result
call getvar DoorName,LineNumber,7
telnum=result
call getvar DoorName,LineNumber,20
access=result
call getvar DoorName,LineNumber,9
width=result-2
call getvar DoorName,LineNumber,8
mode=result
co = mode
gfx = co
if mode = 1 then mode = "Color"
ELSE mode = "B/White"
if mode = "Color" then colr = "NONE"
ELSE colr = "MONO"
IF gfx ~= "0" THEN DO
black = '
' ; blackback = '
'
red = '
' ; redback = '
'
green = '
' ; greenback = '
'
yellow = '
' ; yellowback = '
'
blue = '
' ; blueback = '
'
magenta = '
' ; magentaback = '
'
cyan = '
' ; cyanback = '
'
white = '
' ; whiteback = '
'
italics = '
'
bold = '
'
los = "H"
los1 = "C";los2 = "C";los3 = "B"
normal = '
'
cls = '0C'x||''
yesno = white"("green"y"white"/"red"N"white")"
noyes = white"("green"Y"white"/"red"n"white")"
END
ELSE DO
black = '' ; blackback = ''
red = '' ; redback = ''
green = '' ; greenback = ''
yellow = '' ; yellowback = ''
blue = '' ; blueback = ''
magenta = '' ; magentaback = ''
cyan = '' ; cyanback = ''
white = '' ; whiteback = ''
italics = ''
bold = ''
los = ""
normal = ''
cls = '0C'x
yesno = '(y/N)'
noyes = '(Y/n)'
signal byeforcolor
END
if exists(dir"INUSE") then do
call open file, (dir"INUSE"), 'R'
WHOON = readln(file);call close file
if right(whoon,1) = linenumber then signal start0
string = cls;call output
string = program" is currently being played by "WHOON" on line "right(whoon,1);call output
string = "Try back in a little while...";call outputthendelay 2
call blank
call close file
call pause
signal byeinuse
end
start0:
if exists(dir"INUSE") then do
flnm=dir"inuse"
call deletefile
end
if ~exists(dir"INUSE") then do;call open file, (dir"INUSE"), 'W'
call writeln file, handlename||" "||linenumber;call close file;end
/**********************************************************************/
/* MY STANDARD TEMPLATE ENDS HERE */
/**********************************************************************/
/**********************************************************************/
/* BBS VARIABLES */
/**********************************************************************/
sysop = 'ED KOLAR' /* PUT YOUR NAME HERE */
Sysopname = 'MR. ED' /* PUT YOUR NAME HERE */
BBSname = 'Chalkboard I & II BBS Network' /* ETC.... */
Progname = 'Chalkboard Downs ' /* Change below to your name but match the spacings*/
Exit_string = " "yellowback||black||bold" Now returning you to that Wonderful Chalkboard I & II BBS "
Exit_string2 = blue" Chalkboard I & II BBS "white"203-449-8100"
Exit_string41 = normal" "yellowback||black||bold" Now returning you to that wonderful "
Exit_string42 = normal" "yellowback||black||bold" Chalkboard I & II BBS "normal||cyan
Guessadd = 50
/**********************************************************************/
/* End of BBS VARIABLES */
/**********************************************************************/
/**********************************************************************/
/* START OF ACTIUAL PROGRAM */
/**********************************************************************/
Udate = time(N) /* get current date & time */
Hname.1 = "Tumble Weed"
Hname.2 = "Frisky Girl"
Hname.3 = "Citation"
Hname.4 = "Thunder" /* CHANGE THESE NAMES TO ANYTHING THAT SUITS YOU... */
Hname.5 = "Whirlaway"
Hname.6 = "Seabiscuit"
Hname.7 = "Comet"
Hname.8 = "Old-Nag"
MAIN:
call random(1,10,time(s))
CALL PLAYERFILE
CALL CHECKBALANCE
Choice = 0
Do until Choice = 5 | Choice = 'Q'
string = CLS;call output
string = yellow" *********************************";call output
string = magenta" Welcome to "green||progname;call output
string = yellow" *********************************";call output
call blank
string = yellow" 1)"green" Read Instructions";call output
string = yellow" 2)"green" View Scoreboard";call output
string = yellow" 3)"green" Millionaires Club";call output
string = yellow" 4)"green" Go to the Track!";call output
string = yellow" 5)"green" Quit";call output
call blank
string = yellow" ***************************";call output
call blank
string = " What would you like to do? ";call getkey
call check
Choice=upper(hot)
If Choice = 1 | Choice = 'I' then CALL INSTRUCT
else If Choice = 2 | Choice = 'S' then CALL SCOREBOARD
else If Choice = 3 | Choice = 'M' then CALL MILLIONS
else If Choice = 4 | Choice = 'T' then CALL THETRACK
end
CALL BYE
signal exit_normal
PLAYERFILE:
string = CLS;call output
string = yellow"CChecking player file...";call output
call blank
AcctBal = 100
Flag = 0
nplayers = 0
if ~exists(dir||'Dplayers') then do /* Create a Players file if needed*/
call open(file1,dir||'Dplayers', 'W')
call writeln(file1,'0') /* There are no players as yet */
call close(file1)
end
call open(file1,dir||'Dplayers', 'R') /* Read in existing player info */
nplayers = readln(file1) /* Get current number of players */
if nplayers = 0 then signal newfile
do i = 1 to nplayers
player.i = readln(file1) /*Read a player's name*/
score.i = readln(file1) /*Read a player's score*/
if player.i = handlename then do /*find user's acct balance*/
AcctBal = score.i /*set user's acct balance*/
string = white"CI see you have bet here before!";call output
string = white"CYour account balance is: $"green||AcctBal;call output
Flag = 1 /*signal player was found*/
end
end
call close(file1)
Newfile:
if Flag = 0 then do /*if player was not found in file*/
if nplayers < MaxPlayers then do
string = white" A new player!!";call output
string = white" You will be given"green" $100"white" to start you out!";call output
nplayers = nplayers + 1
player.nplayers = handlename
score.nplayers = AcctBal
string = nplayers" Handle is "handlename;call lclmsg
end
else if nplayers >= MaxPlayers then do
call blank
string = "Sorry there is no room for another gambler at the track!";call output
string = "Talk to "SysopName" maybe he/she can do something about that!";call output
CALL BYE
end
end
CALL PAUSE
RETURN
CHECKBALANCE:
LowBal = "FALSE"
If AcctBal <= 2 then do
LowBal = "TRUE"
call blank
string = white"It seems your account balance of $"green||AcctBal||white" is too low to place any bets.";call output
call blank
string = "Would you like to try to win $"guessadd" with no strings attached? ";call msg;string = noyes;call getkeyry
call check
Flag = hot
/*if flag = 'NULL' then flag = "Y"*/
call blank
If Flag = "Y" then do
call blank;call blank
string = cyan"Okay, Pick a number between "white"1 "magenta;call msg;string = "and "white"5"cyan": ";length = 1;call input
call check
Guess=typed;if upper(guess) = 'NULL' then guess = "0"
RNum = RANDOM(1,5)
if Guess = RNum then do
call blank
string = white"BYou guessed it!!! Adding "green||guessadd||white" to your Account Balance...";call output
call blank
AcctBal = AcctBal + guessadd
LowBal = "FALSE"
end
else do
if guess = '0' then call message doorname,linenumber,red||cyanback" If you don't pick a number you will never win at this! "normal||cyan,1
call blank
string = white"Sorry the number was "red||RNum||white". Try again sometime!";call output
call blank
end
end
else do
call blank
string = magenta"Okay fine...but you won't be able to place any bets until ";call output
string = "you have more money!!";call output
call blank
end
CALL PAUSE
end
RETURN
INSTRUCT:
string = CLS;call output
if exists(dir||'Horsence') then do
call open(docs,dir||'horsence', 'R')
do while ~eof(docs)
line = readln(docs)
string = cyan||line;call output
end
call close(docs)
end
else do
string = white"Horsence-Instructions file was not found...";call output
string = white"Notify "cyan||Sysopname||white"!";call output
end
call blank
CALL PAUSE
RETURN
SCOREBOARD:
string = CLS "Sorting Scores.............";call output
CALL SORTSCORES
Flag = 1
i = 1
j = 1
More = 'Y'
Do Forever
if More ~= 'Y' then break
Do while Flag = 1
string = CLS;call output
string = yellow" *******************************";call output
string = magenta" SCOREBOARD";call output
string = yellow" *******************************
";call output
Flag = 0
end
if player.j = handlename then Score.j = AcctBal
P = Left(Player.j,20,' ') /*Pad end of handle with spaces*/
string = " "P" $"Score.j;call output
i = i + 1
j = j + 1
if j > Nplayers then break
else if j <= Nplayers & i = 11 then do
Flag = 1
i = 0 /* Only display 10 names per page */
string = yellow" *******************************";call output
string = yellow" Do you want to see more? ";call msg;string = noyes;call getkeyry
call check
more = upper(hot);if more = 'NULL' then more = "Y"
iterate
end
else if j <= Nplayers & i < 11 then iterate
end
if More = 'Y' then string = yellow" *******************************";call output
CALL PAUSE
RETURN
MILLIONS:
drop hot
call blank
call blank
if exists(dir'Dmillions') then do
call open(mill,dir||'Dmillions', 'R')
j = 0
i = 0
do while ~eof(mill)
do while j = 0
string = CLS;call output
string = yellow" ***********************************************";call output
string = yellow" *"magenta" MILLIONAIRES CLUB "yellow" *";call output
string = yellow" ***********************************************
";call output
j = 1
end
line = readln(mill)
parse var line p1 p2 p3 p4 p5 p6 p7 p8 p9
if length(p1) <10 then do
p1=p1||" "||p2
p2=p3;p3=p4;p4=p5;p5=p6;p6=p7;p7=p8
end
line = magenta||p1||cyan" reached "green||p3||cyan" at "yellow||p5||cyan" on "yellow||p7
string = " "line;if p1 = '' then iterate;call output
i = i + 1
if i = 10 then do;call blank;call blank
j = 0
i = 0
string = magenta" More? "yesno;call getkeyrn
if hot = "N" then do
call close(mill)
leave
end
else iterate
call PAUSE
end
end
call close(mill)
end
else do
string = magenta"There are no millionaires yet...";call output
end
call blank
if hot ~= "N" then CALL PAUSE
RETURN
CHECKMILLIONS:
if acctbal >= 1000000 then do
string = magenta" ";call output
string = "Congratulations!!!! You have become a Millionaire!!";call output
string = "Adding your name to this elite group of gamblers....";call output
call blank
line = left(handlename,22,'.')||" reached $"AcctBal||" at "||left(time(n),5)||" on "||date(u)
if ~exists(dir'Dmillions') then do /* Create a Dmillions file if needed*/
call open(fileM,dir||'Dmillions', 'W')
call writeln(fileM, line) /* Put player in file */
call close(fileM)
end
else do
call open(fileM,dir||'Dmillions', 'A')
call writeln(fileM,line) /* Add player to file */
call close(fileM)
end
AcctBal = 1000
string = white"Your new account balance is"green" $1,000.";call output
call blank
string = white"Would you like to see the Millionaires Club list? ";call msg;string = noyes;call getkeyry
call check
more = upper(hot)
If More = "Y"| More = "NULL" then CALL MILLIONS
end
RETURN
SORTSCORES:
/* Straight Selection Sort */
do i = 1 to (Nplayers - 1)
do j = (i+1) to Nplayers
if Score.i < Score.j then do
Temp = Score.i
Score.i = Score.j
Score.j = Temp
Temp = Player.i
Player.i = Player.j
Player.j = Temp
end
end
end
RETURN
THETRACK:
Another = "Y"
Do While Another = "Y"
CALL CHECKBALANCE
If LowBal = "FALSE" then do
CALL BOOKIE
CALL GETBETS
CALL RACE
CALL WINNERS
call blank
string = magenta"Do you want to play another race? "noyes;call getkeyry
call check
Another = upper(hot)
if another = 'NULL' then another = "Y"
end
else Another = "N"
end
RETURN
BOOKIE:
/* Choose the odds on the horses */
do i = 1 to 8
WOdds.i = random(1,15) /* Pick a random number*/
POdds.i = Left(WOdds.i *.75,pos('.', WOdds.i*.75) -1)
SOdds.i = Left(WOdds.i *.5,pos('.', WOdds.i*.5) -1)
end
/* Set all bets to zero */
do i = 1 to 3
WHorse.i = 0
WBet.i = 0
end
string = CLS;call output
string = yellow"*********************************************************************";call output
string = magenta" PLACE YOUR BETS!!";call output
string = yellow"*********************************************************************";call output
string = magenta" No. Horse Win Odds Place Odds Show Odds";call output
string = magenta" --- --------------- -------- ---------- ---------"cyan;call output
do i = 1 to 8
tes1 = right(Hname.i,16,' ')
tes2 = right(WOdds.i,14,' ')
tes3 = right(POdds.i,12,' ')
string = right(i,4,' ');call msg /* Horse No. */
string = tes1;call msg /* Horse's name */
string = tes2":1";call msg /* Win Odds */
string = tes3":1";call msg /* Place Odds */
string = right(SOdds.i,12,' ')":1";call output /* Show Odds */
end
string = yellow"*********************************************************************";call output
call blank
RETURN
GETBETS:
wbetistring = " B"
str.1 = "WIN: "
str.2 = "PLACE: "
str.3 = " SHOW: "
i = 1
do forever
/* Position cursor for each bet */
string = "HBB ";call output
ab = Left(AcctBal,10,'.')
string = white"Your account balance is:"green" $"AB||white;call output
do j = 1 to 3
string = " ";call output
end
string = "A";call output
if i > 3 then break /* Check for all bets in*/
if AcctBal < 2 then break /* Not enough money to bet anymore */
/* Get the horse number to bet on for each: win, place, show */
string = yellow"Enter the horse number to " str.i ;call msg;string = cyan;call getkey
WHorse.i=upper(hot);if upper(hot) ~= 'Q'& (upper(hot) <1|upper(hot)>8) then WHorse.i = 'NULL'
string = magenta||WHorse.i' 'yellow;if whorse.i = 'NULL' then string = '';call output
CALL CHECK
if WHorse.i = 'NULL' then do
/* Check if user pressed return, if so there is no bet on this round */
WBet.i = 0
i = i + 1
iterate
end
else
if WHorse.i = 'Q' then call bye
if WHorse.i < 1 | WHorse.i > 8 then do
/* Make sure horse number bet on is within range */
string = "1H ";call msg
string = magenta"Invalid "cyan"Horse "magenta"number. "white"Try again"red"!"yellow;call outputthendelay 1
string = " B";call output
iterate
end
if Whorse.i ~= 'NULL' then do
/* If a horse is being bet on then get the amount of the bet */
string = "and how much do you want to bet: "magenta;length = 4;call input;if typed = 'NULL' then typed = '0'
WBet.i=upper(typed)
call check
if WBet.i >= 2 & WBet.i <= AcctBal & WBet.i <= 2000 then do
/* make sure the amount of the bet is within range */
AcctBal = AcctBal - WBet.i
i = i + 1
iterate
end
else if WBet.i < 2 then do
/* if bet is too low then redo */
string = "1H ";call msg
string = magenta"Sorry you must bet at least"green" $2."magenta" "white"Try again"red"!"yellow;call msgthendelay 1
call blank
iterate
end
else if WBet.i > AcctBal then do
/* if bet is too high then redo */
string = "1H ";call msg
string = magenta"You can not bet more than your account balance of: "green" $"AcctBal||magenta". "white"Try again"red"!"yellow;call outputthendelay 2
call blank
iterate
end /* else */
else if WBet.i > 2000 then do
/* if bet is too high then redo */
string = "1H ";call msg
string = magenta"You can not bet more than "green"$2,000."magenta" "white"Try again"red"!"yellow;call outputthendelay 1
call blank
iterate
end /* else */
end /* else do */
/* 'message' "" */
end /* do forever */
string = red"Bringing the horses out onto the track..."green" Please wait..";call outputthendelay 1
if AcctBal < 2 then do
string = "BYou have bet as much as you can. The window is now closed!!";call outputthendelay 1;end
/* string = "B";call output
CALL PAUSE*/
RETURN
RACE:
string = CLS"H";call output /* clear screen and go to home position */
call blank
string = white"";call output
call blank
call blank
/* The race itself is 55 spaces long */
string = green"++++++++++++|"red"Start"yellow"-------------------------------------"green"Finish|";call output
/*'message' '' */
do i = 1 to 8
string = magenta||RIGHT(Hname.i, 12,' ')"|";call output
Count.i = 15 /* reset all horse counters */
end
string = green"++++++++++++|"yellow"------------------------------------------------"green"|";call output
string = white;call output
win = 0 /* no winning horse yet */
place = 0 /* no place horse yet */
show = 0 /* no show horse yet */
j = random(1,8) /* pick random horse to start out of gate */
Flag = "Go"
call pause1
Do while Flag = "Go"
i = j
j = 1 /* always start at 1 after 1st time through loop */
do while i <= 8 /* cycle through each horse and add up their 'scores' */
RNum = random(1,5) /* Pick a random number*/
string = ""i+6";"Count.i"H ";call msg
Count.i = Count.i + RNum /* Add the number to the current horse's count */
/* Draw the horse's new position if he has not already crossed finish line*/
If (i ~= Win) & (i ~= Place) & (i ~= Show) then do
string = ""i+6";"Count.i"H"i;call msg
end
/* Check for win, place, and show horse */
If Count.i >= 62 then do
If Win = 0 then do
Win = i /* remember winning horse's number */
string = ""6+i";"Count.i"H"||cyan||" W "white||HName.i;call output
end
else if (Place = 0) & (i ~= Win) then do
Place = i /* remember place horse's number */
string = ""6+i";"Count.i"H"||cyan||" P "white||HName.i;call output
end
else if (Show = 0) & (i ~= Win) & (i ~= Place) then do
Show = i /* remember show horse's number */
string = ""6+i";"Count.i"H"cyan" S "white||HName.i;call output
i = 8 /* race is over */
Flag = "Stop" /* signal end of race */
end
end /* If Count.i >= 55 then do */
i = i + 1
end /* Do while i <= 8 */
end /* Do while Flag = "Go" */
string = "HBB";call output
/* CALL PAUSE2 */
RETURN
WINNERS:
call blank
string = cyan"Horse #"Win" "white||HName.win||cyan" is the winner!!";call output
If WHorse.1 = 'NULL' then call message doorname,linenumber,red"You did not bet on a horse to win!",1
else do
string = "You bet $"WBet.1" on Horse #"WHorse.1" to win.";call output
If WHorse.1 = Win then do
Won = WBet.1 * WOdds.Win
AcctBal = AcctBal + Won + WBet.1
string = yellow"Congratulations! You "green"WIN"yellow" $"green||Won||magenta" on your win bet!";call output
end
else do
string = yellow"Sorry you "cyan"LOST"yellow" on your win bet.";call output;end
end
call blank
string = cyan"Horse #"Place" "white||HName.place||cyan" placed!";call output
If WHorse.2 = 'NULL' then call message doorname,linenumber,red"You did not bet on a horse to place!",1
else do
string = "You bet $"WBet.2" on Horse #"WHorse.2" to place.";call output
If (WHorse.2 = Place) | (WHorse.2 = Win) then do
Won = WBet.2 * WOdds.Place
AcctBal = AcctBal + Won + WBet.2
string = yellow"Congratulations! You "green"WIN $"Won||yellow" on your place bet!";call output
end
else do;string = yellow"Sorry you "cyan"LOST"yellow" on your place bet.";call output;end
end
call blank
string = cyan"Horse #"Show" "white||HName.show||cyan" showed.";call output
If WHorse.3 = 'NULL' then call message doorname,linenumber,red"You did not bet on a horse to show!",1
else do
string = "You bet $"WBet.3" on Horse #"WHorse.3" to show.";call output
If (WHorse.3 = Show) | (WHorse.3 = Place) | (WHorse.3 = Win) then do
Won = WBet.3 * WOdds.Show
AcctBal = AcctBal + Won + WBet.3
string = yellow"Congratulations! You "green"WIN"yellow" $"Won||yellow" on your show bet!";call output
end
else do
string = yellow"Sorry you "cyan"LOST"yellow" on your show bet."
call output
end
end /*call pause*/
RETURN
PAUSE:
call blank
call getreturn
call blank
RETURN
PAUSE2:
call getreturn
string = ""cls;call output
RETURN
PAUSE1:
string = "H";call output
string = cyan"Press any key to Start the RACE...";call getkey
string = "H ";call output
string = "HTHEY'RE OFFl!!!";call output
RETURN
BYE:
CALL CHECKMILLIONS
byeforcolor:
if co = 0 then do
call blank
string = " I'm sorry but you MUST have ANSI COLOR and ANSI POSITIONING here.";call outputthendelay 2
signal exit_normal
end
string = cls;call output
call blank
call blank
string = yellow" Brought to you by "cyan||sysop;call output
call blank
string = exit_string2;call output
call blank
string = yellow" Ported over to Mebbsnet by "white"Mr. Ed";call output
call blank
call blank
call blank
CALL SORTSCORES
/* Rewrite PlayersFile */
call close(file1)
call open(file1,dir||'Dplayers', 'W')
call writeln(file1,NPlayers)
do i = 1 to NPlayers
if player.i = handlename then Score.i = AcctBal
call writeln(file1, player.i)
call writeln(file1, score.i)
end
call close(file1)
if exists(dir'INUSE') then do
call blank
address command "delete "||dir||"INUSE"
address
call blank
end
signal exit_normal
byeinuse:
if handlename = sysopname then do
string = 'Do you want to delete the INUSE as Bogus??? 'noyes;call getkeyry
if upper(hot) = "Y"|upper(hot) = "NULL" then do
address command "delete "||dir||"INUSE"
address
signal start0
end
end
call EXIT_normal
/******************************* Procedures *************************/
Exit_Normal:
call blank;call blank;call blank;call blank;call blank
string = exit_string;call outputthendelay 2
call Exit_Door DoorName,LineNumber
exit 0
Exit_Normal40:
call blank;call blank;call blank;call blank;call blank
string = exit_string41;call output
string = exit_string42;call outputthendelay 2
call Exit_Door DoorName,LineNumber
exit 0
DELETEFILE:
address command "delete "flnm
address
return
GETRETURN:
string = center(CYAN||ITALICS" Press RETURN when ready..."NORMAL,width)
call hotkey doorname,linenumber,string
hot=""
return
GETKEYRN:
call hotkey doorname,linenumber,string
hot=upper(result)
if hot = "Y" then do
string =green" Yes"
call output
end
else do /* yesno = "
(
y
/
N
)"*/
hot = "N"
string = red" No"
call output
end
return
GETKEYRY:
call hotkey doorname,linenumber,string
hot=upper(result)
if hot = "N" then do
string = red" No"
call output
end /* noyes = "
(
Y
/
n
)"*/
else do
hot = "Y"
string = green" Yes"
call output
end
return
GETKEY:
call hotkey doorname,linenumber,string
hot=upper(result)
return
INPUT:
call prompt doorname,linenumber,string,length
typed=result
return
OUTPUTTHENDELAY:
arg reps
call message doorname,linenumber,string,1
do x = 1 to reps
address command "wait 1"
address
end
reps = 1
return
OUTPUT:
call message doorname,linenumber,string,1
return
MSGTHENDELAY:
arg reps
call message doorname,linenumber,string,0
do x = 1 to reps
address command "wait 1"
address
end
reps = 1
return
MSG:
call message doorname,linenumber,string,0
return
BLANK:
blnk = " "
call message doorname,linenumber,blnk,1
return
GETOUT:
call blank
call Exit_Door DoorName,LineNumber
exit 0
Carrier:
call CDetect doorname,linenumber
cd=result
return
drophim:
call HangUp DoorName,LineNumber
exit 0
readgr:
call ReadGra doorname,linenumber,string
return
readfl:
call ReadFile doorname,linenumber,string
return
lclmsg:
call LocalMessage doorname,linenumber,string,1
return
check: /* check for lost carrier or spaced-out player */
call carrier
if cd = "No carrier!" then signal drophim
return
/************************* End of Procedures ************************/
/**************************ERROR******Procedures*****************************/
IOERR:
err_line = SIGL ; sev = RC ; code = sev
string ="**Crash** Looks like we got an I/O error somewhere!"
call output
signal log_it
ERROR:
err_line = SIGL ; sev = RC ; code = sev
string ="**Crash** Looks like we got some sort of error!"
call output;trace A
say err_line sev code
signal log_it
SYNTAX:
err_line = SIGL ; sev = RC ; code = sev
string ="**Crash** Looks like we got a syntax error somewhere!"
call output
signal log_it
log_it:
trace off
string ="Looks like we're gonna have to bail outta this mess......"
call output
/*--------------------------------LOG-ERRORS----------------------------*/
call blank
string = "Inform Sysop to check the error log!"
call outputthendelay 1
if ~exists('bbs:logs') then makedir('BBS:Logs')
if ~exists('BBS:Logs/Errlog') then call open(err,'BBS:Logs/Errlog','W')
else call open(err,'BBS:Logs/Errlog','A')
call writeln(err,date() time());call writeln(err,name" - "||doorname)
call writeln(err,"Line - "err_line" Code - "code" User - "username);call writeln(err,errortext(code))
call writeln(err,"");call close(err)
call Exit_Door doorname,linenumber
exit 0